home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bboprocl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-22  |  2.8 KB  |  115 lines
  1. (*===========================================================================*)
  2. (* Set clock command                                                         *)
  3. (*                                                                           *)
  4. (*   Copyright 1990 by H. Roy Engehausen.  All rights reserved.              *)
  5. (*   This software may be freely distributed and used, but it may not        *)
  6. (*   under any circumstances be sold by anyone other than the author.        *)
  7. (*   It may be distributed by a commercial company as long as it is          *)
  8. (*   for no cost.                                                            *)
  9. (*                                                                           *)
  10. (*===========================================================================*)
  11.  
  12. PROCEDURE set_clock(cmd_string : STRING);
  13.  
  14.   VAR
  15.     out_dt     : DATETIME;
  16.     word_count : BYTE;
  17.  
  18.   FUNCTION get_num(low_bound  : BYTE;
  19.                    high_bound : BYTE) : WORD;
  20.  
  21.   VAR
  22.     code : INTEGER;
  23.     i    : INTEGER;
  24.     s    : STRING[2];
  25.  
  26.   BEGIN;
  27.  
  28.     s := COPY(cmd_string, 1, 2);
  29.     cmd_string := COPY(cmd_string, 3, 255);
  30.  
  31.     VAL(s, i, code);
  32.  
  33.     IF (code <> 0) OR (i < low_bound) OR (i > high_bound) THEN
  34.       BEGIN;
  35.  
  36.         send_tnc_data_str('Invalid number -- ' + s + cr);
  37.  
  38.         active_tcb^.error_sw := TRUE;
  39.         get_num              := 0;
  40.  
  41.       END
  42.     ELSE
  43.       get_num := i;
  44.  
  45.   END;
  46.  
  47. BEGIN;
  48.  
  49.   strip_var(cmd_string, 'B');
  50.  
  51.   word_count := words(cmd_string);
  52.  
  53.   IF word_count = 1 THEN
  54.     BEGIN;
  55.       send_tnc_data_str(todays_date_time + cr);
  56.       EXIT;
  57.     END;
  58.  
  59.   IF cmd_string[2] <> ' ' THEN
  60.     BEGIN;
  61.       send_message(message_err_2nd);
  62.       active_tcb^.error_sw := TRUE;
  63.       EXIT;
  64.     END;
  65.  
  66.   IF word_count > 2 THEN
  67.     BEGIN;
  68.       send_message(message_err_wrd);
  69.       active_tcb^.error_sw := TRUE;
  70.       EXIT;
  71.     END;
  72.  
  73.   IF word_count < 2 THEN
  74.     BEGIN;
  75.       send_message(message_not_en);
  76.       active_tcb^.error_sw := TRUE;
  77.       EXIT;
  78.     END;
  79.  
  80.   cmd_string := subword(@cmd_string, 2, 1);
  81.  
  82.   IF LENGTH(cmd_string) <> 10 THEN
  83.     BEGIN;
  84.       send_tnc_data_str('Date must be YYMMDDHHMM');
  85.       active_tcb^.error_sw := TRUE;
  86.       EXIT;
  87.     END;
  88.  
  89.   out_dt.year  := 1900 + get_num(90, 99);
  90.   IF active_tcb^.error_sw THEN
  91.     EXIT;
  92.  
  93.   out_dt.month := get_num(1, 12);
  94.   IF active_tcb^.error_sw THEN
  95.     EXIT;
  96.  
  97.   out_dt.day   := get_num(1, 31);
  98.   IF active_tcb^.error_sw THEN
  99.     EXIT;
  100.  
  101.   out_dt.hour  := get_num(0 ,23);
  102.   IF active_tcb^.error_sw THEN
  103.     EXIT;
  104.  
  105.   out_dt.min   := get_num(0 ,59);
  106.   IF active_tcb^.error_sw THEN
  107.     EXIT;
  108.  
  109.   SETDATE(out_dt.year, out_dt.month, out_dt.day);
  110.   SETTIME(out_dt.hour, out_dt.min  , 0, 0);
  111.  
  112.   send_message(message_op_complete);
  113.  
  114. END;
  115.